Pensieve header: Testing the overhand equation.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2012-04"];
<< betaCalculus.m

Clear[ℏ];
$PerturbativeDegree=4;
βSimplify[expr_]:= Replace[
Series[Normal[expr], {ℏ, 0, $PerturbativeDegree}],sd_SeriesData :> MapAt[Expand, sd, 3]
];
βCollect[B[ω_, μ_]] := B[
βSimplify[ω],
βSimplify[μ]
];

{V1, {sol}} = Get["VToDegree4-120420.m"];

V1

Φ1=Φ[V1]

The Overhand Equation:

Φ1 // dΔ[1,0,1] // dS[2] // dS[3] // dm[0,3,0] // dm[1,2,1]

{
V0=βCollect[
B[ω[ℏ (Subscript[c, 1]),ℏ (Subscript[c, 2])],α[ℏ (Subscript[c, 1]),ℏ (Subscript[c, 2])]t[1]h[1]+β[ℏ (Subscript[c, 1]),ℏ (Subscript[c, 2])]t[1]h[2]+γ[ℏ (Subscript[c, 1]),ℏ (Subscript[c, 2])]t[2]h[1]+δ[ℏ (Subscript[c, 1]),ℏ (Subscript[c, 2])]t[2]h[2]]
] /. {
(ϵ:(α|β|γ|δ|ω|κ))[___] :> (Subscript[ϵ, 0]), Derivative[k___][(ϵ:(α|β|γ|δ|ω|κ))][___] :> (Subscript[ϵ, FromDigits[{k}]])
},
C0=βCollect[B[κ[ℏ (Subscript[c, 1])],0]] /. {
(ϵ:(α|β|γ|δ|ω|κ))[___] :> (Subscript[ϵ, 0]), Derivative[k___][(ϵ:(α|β|γ|δ|ω|κ))][___] :> (Subscript[ϵ, FromDigits[{k}]])
}
}

({V2, C2}={V0, C0} /. sol) // ColumnForm

Φ2=Φ[V2]

eqn=((Φ2 // dΔ[1,0,1] // dS[2] // dS[3] // dm[0,3,0] // dm[1,2,1])==B[1,0])

sol1=SolveAlways[eqn, {ℏ, (Subscript[c, 1]), (Subscript[c, 2])}];
Length /@ {sol1, sol1=Union[Union /@ sol1]}

sol1

indvars=Union[Cases[Last /@ #, (Subscript[ϵ_, k_]) :> (Subscript[ϵ, k]), Infinity]]& /@  sol1

({V3, C3} = {V2, C2} /. sol1[[1]] /. Thread[{(Subscript[δ, 10]),(Subscript[δ, 21])} -> 0]) // ColumnForm

The third non-degeneracy equation for V:

V2// dS[2] // dm[1,2,1]

(V2 /. sol1[[1]]) // dS[2] // dm[1,2,1]

R[1,1,-1/2]

C3 /. {(Subscript[κ, 1])->0}

((V2 /. sol1[[1]]) // dS[2] // dm[1,2,1])**R[1,1,1/2]

FactorInteger[23040]

23040/5!/2^5

R[1,1,-1/2] // dS[1]

R[1,2] // dS[2] // dm[1,2,1]

R[2,1] // dS[2] // dm[1,2,1]

{R[1,1], R[1,1] // dS[1]} // ColumnForm

R[1,1] == (R[1,2] // dm[2,1,1])

Er=(V2 /. sol1[[1]]) // dS[2] // dm[1,2,1]

23040/1920

1/(1+(1/48) (Subscript[c, 1]^2) (ℏ^2)+(((Subscript[c, 1]^4) (ℏ^4))/23040)+((O[ℏ])^5))

1920/2560

Er**(Er // dS[1])

R[1,1,-1] // dS[1]

Θ[1,2] == (Θ[1,2] // dS[1] // dS[2])

(Er // dS[1])**Er

((Er // dS[1])**Er ) // dcap[1]

{ser=Series[(E^x-1)/x, {x,0,8}], Exp[ser], Log[ser]} // ColumnForm

(Inverse[V2](V2 // dP[3,4])) // dm[2,3,2] // dS[4] // dΔ[4,4,5] // dm[4,1,1] // dm[5,2,2]

((Inverse[V3](V3 // dP[3,4])) // dm[2,3,2] // dS[4] // dΔ[4,4,5] // dm[4,1,1] // dm[5,2,2]) /. (Subscript[γ, 12]) -> -1/1920

Φ1 // dcap[1] // dcap[2] // dcap[3]

Φ1 // Inverse // dcap[1] // dcap[2] // dcap[3]